home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / CUGUK / C005.ZIP / TANH.C < prev   
Text File  |  1990-01-19  |  2KB  |  56 lines
  1. /********************************************************************
  2.  * C Users Group (U.K) C Source Code Library File CUGLIB.005        *
  3.  * Inquiries to: M. Houston, 36 Whetstone Clo. Farquhar Rd.         *
  4.  * Edgbaston, Birmingham B15 2QN ENGLAND                *
  5.  ********************************************************************
  6.  * File name: tanh.c
  7.  * Program name: library modules only
  8.  * Source of file: The Public Domain Software Library.
  9.  * Purpose: maths function
  10.  * Changes: <who what when & why major changes have been made>      
  11.  ********************************************************************/
  12.  
  13.  
  14. /***********************************************************
  15.  *               The TULSA IBM C BOARD                     *
  16.  *                   918-664-8737                          *
  17.  *             300/1200 XMODEM, 24 Hours                   *
  18.  **********************************************************/
  19.  
  20. #include "math.h"
  21.  
  22. #define P0 -0.16134119023996228053e+4
  23. #define P1 -0.99225929672236083313e+2
  24. #define P2 -0.96437492777225469787e+0
  25. #define Q0 +0.48402357071988688686e+4
  26. #define Q1 +0.22337720718962312926e+4
  27. #define Q2 +0.11274474380534949335e+3
  28.  
  29. #define gP(g) (((P2*g P1)*g P0)*g)
  30. #define Q(g) (((g Q2)*g Q1)*g Q0)
  31.  
  32. double tanh(x)
  33. double x;
  34. {
  35.         double f,g,r;
  36.  
  37.         f = fabs(x);
  38.         if (f > 25.3)
  39.                 r = 1.0;
  40.         else if (f > 0.54930614433405484570) {
  41.                 r = 0.5 - 1.0/(exp(f+f)+1.0);
  42.                 r += r;
  43.         } else if (f < 2.3e-10)
  44.                 r = f;
  45.         else {
  46.                 g = f*f;
  47.                 r = f + f*
  48.                         (gP(g)
  49.                         /Q(g));
  50.         }
  51.         if (x < 0.0)
  52.                 r = -r;
  53.         return r;
  54. }
  55.  
  56.